home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / SELOBJ.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-03  |  2KB  |  61 lines
  1. PROCEDURE SELOBJ(VAR KODE:INTEGER);
  2.    VAR
  3.      XREF,YREF:REAL;
  4.      FLAG:BOOLEAN;
  5.      K:INTEGER;
  6.      MSG:SCRLINE;
  7.      OBJNUM:INTEGER;
  8.      DMIN,DIST,D:REAL;
  9.    BEGIN
  10.      KODE := 1;
  11.      DMIN := (XWMAX-XWMIN)/20.0;
  12.      MOVCUR(24,2);
  13.      WRITE('Select Object & press Left button (Right button to cancel) >');
  14.      RING(1);
  15.      FLAG := FALSE;
  16.      WHILE NOT(FLAG) DO
  17.        BEGIN
  18.         GETMOUSE(X,Y,PIXX,PIXY,OPTION);
  19.         IF (BUTTON1) OR (BUTTON2) THEN FLAG := TRUE;
  20.         IF (BUTTON1) AND (OPTION <> 0) THEN
  21.            BEGIN
  22.              FLAG := FALSE;
  23.              RING2;
  24.              MOVCUR(24,1);
  25.              WRITE(BLKLINE);
  26.              MOVCUR(24,2);
  27.              WRITE('Move mouse cursor into graphics area!!');
  28.            END;
  29.        END;
  30.      IF BUTTON1 THEN
  31.         BEGIN
  32.           M1 := 2;
  33.           MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  34.           MARK(PIXX,PIXY,HRCOLOR);
  35.           M1 := 1;                     (* SHOW MOUSE *)
  36.           MOUSE(M1,M2,M3,M4);
  37.           XREF := X;
  38.           YREF := Y;
  39.           SELNUM := 0;
  40.           DIST   := ABS(XWMAX-XWMIN);
  41.           FOR K := 1 TO OBJPTR-1 DO
  42.            WITH DRAWARY[K] DO
  43.             BEGIN
  44.                CASE OBJTYP OF
  45.             0: D := ABS(XWMAX-XWMIN);                  (*  DEL. OBJ. *)
  46.             1: PTDIST(XREF,YREF,X1,Y1,D);              (*  POINT  *)
  47.             2: LNDIST(XREF,YREF,X1,Y1,X2,Y2,D);        (*  LINE   *)
  48.             3: BXDIST(XREF,YREF,X1,Y1,X2,Y2,X3,Y3,D);  (*  BOX    *)
  49.             4: CIRDIST(XREF,YREF,X1,Y1,X2,D);          (*  CIRCLE *)
  50.               END; (* CASE *)
  51.             IF DIST > D THEN
  52.                BEGIN
  53.                  DIST := D;
  54.                  SELNUM := K;
  55.                END;
  56.             END; (*WITH*)
  57.             IF (SELNUM <> 0) AND (DIST < DMIN) THEN KODE := 0;
  58.         END; (*IF*)
  59.       MOVCUR(24,1);
  60.       WRITE(BLKLINE);
  61.   END; (*PROC*)